home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / netprn.zip / EXPRNQUE.PAS next >
Pascal/Delphi Source File  |  1992-11-09  |  10KB  |  383 lines
  1. {$S-,R-}
  2. program ExPrnQue;
  3.   {-Example program showing how to submit a file directly to a print queue.}
  4. uses
  5.   {$IFNDEF Windows}
  6.   Crt,
  7.   {$ENDIF}
  8.   NetWare,
  9.   NetBind,
  10.   NetQue,
  11.   NetPrnQue
  12.   {$IFDEF Windows}
  13.   , WinCrt
  14.   {$ENDIF}
  15.   ;
  16.  
  17. var {global vars}
  18.   Result : Byte;
  19.   ObjectID : LongInt;
  20.  
  21. function Pad(S : String; Len : Byte) : String;
  22. var
  23.   I : Byte;
  24. begin
  25.   if Length(S) < Len then
  26.     for I := 1 to Len - Length(S) do
  27.       S := S + ' ';
  28.   Pad := S;
  29. end;
  30.  
  31. function Long2Str(L : LongInt) : String;
  32. var
  33.   S : String;
  34. begin
  35.   Str(L, S);
  36.   Long2Str := S;
  37. end;
  38.  
  39. function ZeroFill(B : Byte) : String;
  40. begin
  41.   if B < 10 then
  42.     ZeroFill := '0' + Long2Str(B)
  43.   else
  44.     ZeroFill := Long2Str(B);
  45. end;
  46.  
  47. function Date2Str(var DT : QMSDateTime) : String;
  48. type
  49.   PAny = ^TAny;
  50.   TAny =
  51.     record
  52.       L : LongInt;
  53.       W : Word;
  54.     end;
  55. begin
  56.   with PAny(@DT)^ do
  57.     if (L = -1) and (W = $FFFF) then begin
  58.       Date2Str := 'anytime';
  59.       Exit;
  60.     end;
  61.   with DT do
  62.     Date2Str := ZeroFill(H) + ':' + ZeroFill(Min) + ' ' + ZeroFill(M) + '/' +
  63.                 ZeroFill(D) + '/' + ZeroFill(Y);
  64. end;
  65.  
  66. function Banner2Str(var Banner) : String;
  67. var
  68.   B : Array[1..13] of Char absolute Banner;
  69.   S : String;
  70.   I : Byte;
  71. begin
  72.   S := '';
  73.   for I := 1 to 13 do
  74.     if B[I] <> #0 then begin
  75.       Inc(byte(S[0]));
  76.       S[I] := B[I];
  77.     end
  78.     else begin
  79.       Banner2Str := S;
  80.       Exit;
  81.     end;
  82. end;
  83.  
  84. function Flags2Str(Flags : Byte) : String;
  85. var
  86.   S : String;
  87. begin
  88.   S := '';
  89.   if Flags and jcfUserHold > 0 then
  90.     S := 'U';
  91.   if Flags and jcfOperatorHold > 0 then
  92.     S := S + 'O';
  93.   Flags2Str := S;
  94. end;
  95.  
  96. function Desc2Str(var TextJob : TextJobField) : String;
  97. var
  98.   S : String;
  99. begin
  100.   S := '';
  101.   Move(TextJob, S[1], SizeOf(TextJobField));
  102.   S[0] := Char(SizeOf(TextJobField));
  103.   while (S[Length(S)] = #0) and (Length(S) > 0) do
  104.     Dec(Byte(S[0]));
  105.   Desc2Str := S;
  106. end;
  107.  
  108. procedure AddToQue;
  109. var
  110.   JobEntry : JobEntryType;
  111.   FName : String;
  112.   Desc : String;
  113. begin
  114.   Write('Enter filename to add to print queue: ');
  115.   ReadLn(FName);                                     {get name of file}
  116.   if Length(FName) = 0 then
  117.     Exit;
  118.   Write('Enter description of print job: ');
  119.   ReadLn(Desc);
  120.   FillChar(JobEntry, SizeOf(JobEntry), 0);          {zero out record}
  121.   with JobEntry do begin
  122.     TargetServerID := -1;                           {any server will do}
  123.     FillChar(TargetExecTime, SizeOf(TargetExecTime), $FF); {first opportunity}
  124.     JobType := 0;               {!!NOTE: this field specifies the FormType!!}
  125.     JobControlFlags := jcfAutoStart (*+ jcfUserHold*);
  126.     Move(Desc[1], TextJobDesc, Length(Desc));
  127.   end;
  128.   MakeClientRecord(4, 1, pqNotify+pqFormFeed, 0, 0, '', '',
  129.                    JobEntry.ClientRecord);           {format the client record}
  130.   Result := AddFileToPrintQueue(ObjectID, JobEntry, FName); {add file to queue}
  131.   if Result = 0 then
  132.     WriteLn(FName, ' added to queue')
  133.   else
  134.     WriteLn('error ', Result);
  135. end;
  136.  
  137. procedure DeleteFromQue;
  138. var
  139.   S : String;
  140.   JN, C : Word;
  141. begin
  142.   Write('Enter number of job to delete: ');
  143.   ReadLn(S);
  144.   Val(S, JN, C);
  145.   if C = 0 then
  146.     WriteLn('Result of delete = ', RemoveJobFromQueue(ObjectID, JN))
  147.   else
  148.     WriteLn('Invalid number')
  149. end;
  150.  
  151. procedure WriteJobHeader;
  152. begin
  153.          {          1         2         3         4         5         6    }
  154.          { 12345678901234567890123456789012345678901234567890123456789012  }
  155.   WriteLn('JobNum Station EntryTime       Type  JobPos  Flags Desc');
  156. end;
  157. procedure DumpJob(JobNumber : Word);
  158. var
  159.   JobEntry : JobEntryType;
  160. begin
  161.   if ReadJobEntry(ObjectID, JobNumber, JobEntry) = 0 then begin
  162.     with JobEntry do begin
  163.       WriteLn(Pad(Long2Str(Swap(JobNumber)), 7),
  164.               Pad(Long2Str(ClientStation), 8),
  165.               Pad(Date2Str(JobEntryTime), 16),
  166.               Pad(Long2Str(JobType), 6),
  167.               Pad(Long2Str(JobPosition), 8),
  168.               Pad(Flags2Str(JobControlFlags), 6),
  169.               Desc2Str(TextJobDesc));
  170.     end;
  171.   end
  172.   else
  173.     WriteLn('Error obtaining job ', JobNumber);
  174. end;
  175.  
  176. procedure ListQue;
  177. var
  178.   Jobs : QueueJobList;
  179.   I : Word;
  180. begin
  181.   GetQueueJobList(ObjectID, Jobs);
  182.   if Jobs.NumJobs = 0 then begin
  183.     WriteLn('No jobs in queue');
  184.     Exit;
  185.   end;
  186.   WriteJobHeader;
  187.   with Jobs do
  188.     for I := 1 to NumJobs do
  189.       DumpJob(JobList[I]);
  190. end;
  191.  
  192. procedure DisplayEditMenu;
  193. begin
  194.   WriteLn('1 - Toggle user hold');
  195.   WriteLn('2 - Change text job description');
  196.   WriteLn('3 - Change number of copies');
  197.   WriteLn('4 - Toggle print job flags');
  198.   WriteLn('5 - Change banner');
  199.   WriteLn;
  200.   WriteLn('0 - Save changes');
  201.   WriteLn('Q - Ignore changes and exit');
  202. end;
  203.  
  204. procedure EditTextJob(var TextJobDesc : TextjobField);
  205. var
  206.   S : String;
  207. begin
  208.   WriteLn('Current text job description is: ', Desc2Str(TextJobDesc));
  209.   Write('Enter new text job description : ');
  210.   ReadLn(S);
  211.   if Length(S) > SizeOf(TextJobField) then
  212.     S[0] := char(SizeOf(TextJobField));
  213.   FillChar(TextJobDesc, SizeOf(TextJobDesc), 0);
  214.   Move(S[1], TextJobDesc, Length(S));
  215. end;
  216.  
  217. procedure EditCopies(var ClientRecord : ClientRecordArea);
  218. var
  219.   S : String;
  220.   Copies, C : Word;
  221. begin
  222.   with PPrintQueClientRec(@ClientRecord)^ do begin
  223.     WriteLn('Number of copies is currently: ', Swap(NumCopies));
  224.     Write('Enter new number of copies   : ');
  225.     ReadLn(S);
  226.     Val(S, Copies, C);
  227.     if C = 0 then
  228.       NumCopies := Swap(Copies)
  229.     else
  230.       WriteLn('Invalid number');
  231.   end;
  232. end;
  233.  
  234. function FlagOn(Value, Flag : Byte) : String;
  235. const
  236.   OffOn : Array[Boolean] of String[3] = ('OFF', 'ON');
  237. begin
  238.   FlagOn := OffOn[Value and Flag > 0];
  239. end;
  240.  
  241. procedure ToggleFlags(var ClientRecord : ClientRecordArea);
  242. var
  243.   S : String;
  244.   C : Char;
  245.   Done : Boolean;
  246. begin
  247.   with PPrintQueClientRec(@ClientRecord)^ do begin
  248.     Done := False;
  249.     repeat
  250.       WriteLn;
  251.       WriteLn('1 - Suppress Form feed        = ', FlagOn(Flags, pqFormFeed));
  252.       WriteLn('2 - Notify submitting station = ', FlagOn(Flags, pqNotify));
  253.       WriteLn('3 - Tab expansion             = ', FlagOn(Flags, pqText));
  254.       WriteLn('4 - Print banner              = ', FlagOn(Flags, pqPrintBanner));
  255.       WriteLn;
  256.       WriteLn('Enter number to toggle or 0 to quit');
  257.       C := Upcase(ReadKey);
  258.       case C of
  259.         '1' :
  260.           if Flags and pqFormFeed > 0 then
  261.             Flags := Flags and (not pqFormFeed)
  262.           else
  263.             Flags := Flags or pqFormFeed;
  264.         '2' :
  265.           if Flags and pqNotify > 0 then
  266.             Flags := Flags and (not pqNotify)
  267.           else
  268.             Flags := Flags or pqNotify;
  269.         '3' :
  270.           if Flags and pqText> 0 then
  271.             Flags := Flags and (not pqText)
  272.           else
  273.             Flags := Flags or pqText;
  274.         '4' :
  275.           if Flags and pqPrintBanner > 0 then
  276.             Flags := Flags and (not pqPrintBanner)
  277.           else
  278.             Flags := Flags or pqPrintBanner;
  279.         '0', 'Q', ^[, ^C : Done := True;
  280.       end;
  281.     until Done;
  282.   end;
  283. end;
  284.  
  285. procedure EditName(var ClientRecord : ClientRecordArea);
  286. var
  287.   S : String;
  288.   Copies, C : Word;
  289. begin
  290.   with PPrintQueClientRec(@ClientRecord)^ do begin
  291.     WriteLn('Current banner is: ', Banner2Str(BannerName));
  292.     Write('Enter new banner : ');
  293.     ReadLn(S);
  294.     if Length(S) > SizeOf(BannerName) then
  295.       S[0] := Char(SizeOf(BannerName));
  296.     FillChar(BannerName, SizeOf(BannerName), 0);
  297.     Move(S[1], BannerName, Length(S));
  298.   end;
  299. end;
  300.  
  301. procedure EditJob(JN : Word);
  302. var
  303.   JobEntry : JobEntryType;
  304.   C : Char;
  305.   Done : Boolean;
  306. begin
  307.   if ReadJobEntry(ObjectID, JN, JobEntry) = 0 then begin
  308.     Done := False;
  309.     repeat
  310.       WriteLn;
  311.       DisplayEditMenu;
  312.       C := Upcase(ReadKey);
  313.       case C of
  314.         '1' :
  315.           with JobEntry do
  316.             if JobControlFlags and jcfUserHold > 0 then
  317.               JobControlFlags := JobControlFlags and (not jcfUserHold)
  318.             else
  319.               JobControlFlags := JobControlFlags or jcfUserHold;
  320.         '2' :
  321.           EditTextJob(JobEntry.TextJobDesc);
  322.         '3' : EditCopies(JobEntry.ClientRecord);
  323.         '4' : ToggleFlags(JobEntry.ClientRecord);
  324.         '5' : EditName(JobEntry.ClientRecord);
  325.         '0' :
  326.           begin
  327.             WriteLn('Result of modify attempt = ',
  328.                     ChangeQueueJobEntry(ObjectID, JobEntry));
  329.             Done := True;
  330.           end;
  331.         'Q' :
  332.           Done := True;
  333.       end;
  334.     until Done;
  335.   end
  336.   else
  337.     WriteLn('Error reading job.');
  338. end;
  339. procedure ModifyQue;
  340. var
  341.   S : String;
  342.   JN, C : Word;
  343. begin
  344.   Write('Enter number of job to modify: ');
  345.   ReadLn(S);
  346.   Val(S, JN, C);
  347.   if C = 0 then
  348.     EditJob(JN)
  349.   else
  350.     WriteLn('Invalid number');
  351. end;
  352.  
  353. procedure UserInterface;
  354.  
  355. var
  356.   Done : Boolean;
  357.   C : Char;
  358. begin
  359.   Done := False;
  360.   repeat
  361.     WriteLn;
  362.     WriteLn('A to add, D to delete, L to list, M to modify, Q to quit');
  363.     C := Upcase(ReadKey);
  364.     case C of
  365.       'A' : AddToQue;
  366.       'D' : DeleteFromQue;
  367.       'L' : ListQue;
  368.       'M' : ModifyQue;
  369.       'Q', ^[, ^C : Done := True;
  370.     end;
  371.   until Done;
  372. end;
  373.  
  374. begin
  375.   WriteLn('EXPRNQUE - Example of print queue routines');
  376.   Result := GetPrinterQueue(0, ObjectID);           {get the print queue}
  377.   if Result <> 0 then begin
  378.     WriteLn('Unable to obtain the print queue ID for LPT1');
  379.     Halt;
  380.   end;
  381.   UserInterface;
  382. end.
  383.